home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / demos / talk2boopsi.pas < prev   
Pascal/Delphi Source File  |  2000-01-01  |  4KB  |  143 lines
  1. PROGRAM Talk2Boopsi;
  2.  
  3. { This example creates a Boopsi prop gadget and integer string gadget, connecting them 
  4. so they }
  5. { update each other when the user changes their value.  The example program only 
  6. initializes   }
  7. { the gadgets and puts them on the window; it doesn't have to interact with them to 
  8. make them  }
  9. { talk to each other.                                                                          
  10. }
  11.  
  12. {
  13.     History:
  14.  
  15.     Changed to use TAGS.
  16.     16 Jul 2000.
  17.  
  18.     Added MessageBox for report.
  19.     31 Jul 2000.
  20.  
  21.     nils.sjoholm@mailbox.swipnet.se
  22.  
  23. }
  24.  
  25. uses Exec, Intuition, Utility, vartags,msgbox;
  26.  
  27.  
  28.  
  29. VAR
  30.    w      : pWindow;
  31.    mymsg  : pIntuiMessage;
  32.    prop,
  33.    int    : pGadget;
  34.    done   : BOOLEAN;
  35.    dummy  : Word;
  36.    temp   : Longint;
  37.    prop2intmap : array[0..1] of tTagItem;
  38.    int2propmap : array[0..1] of tTagItem;
  39.  
  40. CONST
  41.  
  42.    vers  : PChar = '$VER: Talk2boopsi 37.1';
  43.  
  44.     PROPGADGET_ID       = 1;
  45.    INTGADGET_ID        = 2;
  46.    PROPGADGETWIDTH     = 10;
  47.    PROPGADGETHEIGHT    = 80;
  48.    INTGADGETHEIGHT     = 18;
  49.    VISIBLE             = 10;
  50.    TOTAL               = 100;
  51.    INITIALVAL          = 25;
  52.    MINWINDOWWIDTH      = 80;
  53.    MINWINDOWHEIGHT     = (PROPGADGETHEIGHT + 70);
  54.    MAXCHARS            = 3;
  55.  
  56. PROCEDURE CleanUp(Why : STRING; err: Word);
  57. BEGIN
  58.     IF assigned(prop) THEN DisposeObject(prop);
  59.     IF assigned(int) THEN DisposeObject(int);
  60.     IF assigned(w) THEN CloseWindow(w);
  61.     IF Why <> '' THEN MessageBox('Boopsi Report',Why,'OK');
  62.     Halt(err);
  63. END;
  64.  
  65. BEGIN
  66.  
  67.     done := FALSE;
  68.  
  69.     prop2intmap[0] := TagItem(PGA_Top, STRINGA_LongVal);
  70.     prop2intmap[1].ti_Tag := TAG_END;
  71.  
  72.     int2propmap[0] := TagItem(STRINGA_LongVal, PGA_Top);
  73.     int2propmap[1].ti_Tag := TAG_END;
  74.  
  75.     w := OpenWindowTagList(NIL,TAGS(
  76.     WA_Flags,     WFLG_DEPTHGADGET + WFLG_DRAGBAR +
  77.                                WFLG_CLOSEGADGET + WFLG_SIZEGADGET + WFLG_ACTIVATE,
  78.     WA_IDCMP,     IDCMP_CLOSEWINDOW,
  79.     WA_Width,     MINWINDOWWIDTH + 10,
  80.     WA_Height,    MINWINDOWHEIGHT + 10,
  81.     WA_MinWidth,  MINWINDOWWIDTH,
  82.     WA_MinHeight, MINWINDOWHEIGHT,
  83.     TAG_END));
  84.  
  85.     IF w=NIL THEN CleanUp('No window',20);
  86.  
  87.     prop := NewObjectA(NIL, PChar('propgclass'#0),TAGS(
  88.     GA_ID,       PROPGADGET_ID,
  89.     GA_Top,      (w^.BorderTop) + 5,
  90.     GA_Left,     (w^.BorderLeft) + 5,
  91.     GA_Width,    PROPGADGETWIDTH,
  92.     GA_Height,   PROPGADGETHEIGHT,
  93.     ICA_MAP,     Longint(@prop2intmap),
  94.     PGA_Total,   TOTAL,
  95.     PGA_Top,     INITIALVAL,
  96.     PGA_Visible, VISIBLE,
  97.     PGA_NewLook, ltrue, 
  98.     TAG_END));
  99.  
  100.     IF prop = NIL THEN CleanUp('No propgadget',20);
  101.  
  102.     int := NewObjectA(NIL, PChar('strgclass'#0),TAGS(
  103.     GA_ID,      INTGADGET_ID,
  104.     GA_Top,     (w^.BorderTop) + 5,
  105.     GA_Left,    (w^.BorderLeft) + PROPGADGETWIDTH + 10,
  106.     GA_Width,   MINWINDOWWIDTH -
  107.                                   (w^.BorderLeft + w^.BorderRight +
  108.                                   PROPGADGETWIDTH + 15),
  109.     GA_Height,  INTGADGETHEIGHT,
  110.  
  111.     ICA_MAP,    Longint(@int2propmap),
  112.     ICA_TARGET, Longint(prop),
  113.     GA_Previous, Longint(prop),
  114.  
  115.     STRINGA_LongVal,  INITIALVAL,
  116.     STRINGA_MaxChars, MAXCHARS,
  117.     TAG_END));
  118.  
  119.     temp := SetGadgetAttrsA(prop, w, NIL,TAGS(
  120.     ICA_TARGET, Longint(int),
  121.     TAG_END));
  122.  
  123.     IF int = NIL THEN CleanUp('No INTEGER gadget',20);
  124.  
  125.     dummy := AddGList(w, prop, -1, -1, NIL);
  126.     RefreshGList(prop, w, NIL, -1);
  127.  
  128.     WHILE (NOT done) DO BEGIN
  129.         mymsg := pIntuiMessage(WaitPort(W^.UserPort));
  130.         mymsg := pIntuiMessage(GetMsg(W^.UserPort));
  131.         IF mymsg^.IClass = IDCMP_CLOSEWINDOW THEN done := True;
  132.         ReplyMsg(pMessage(mymsg));
  133.     END;
  134.  
  135.     dummy := RemoveGList(w, prop, -1);
  136.     CleanUp('',0);
  137. END.
  138.  
  139.  
  140.  
  141.  
  142.  
  143.